--- Strictness information for function arguments
module frege.compiler.types.Strictness where 

--- Strictness information for function arguments
--- This is stored in 'SymD' and 'SymV' symbols.
data Strictness = U                 --- lazy argument
                | S [Strictness]    {-- strict argument, for product types
                                        there may be additional information for the
                                        subcomponents
                                     -}
                where
                    isStrict U = false
                    isStrict _ = true


instance Eq Strictness where
    U == U = true
    S x == S y = (length x). == (length y) && and (zipWith (Strictness.==) x y)
    _ == _ = false
    hashCode U = 1
    hashCode (S x) = x.hashCode


allLazy   = repeat U


allStrict = repeat (S [])


instance Show Strictness where
    show U = "u"
    show (S []) = "s"
    show (S xs) = "s(" ++ joined "" (map show xs) ++ ")"


{--
 * [usage] @decodeS string@
 * [returns] the decoded strictness value
 * [requires] the string must have been constructed with 'Strictness.show'
 * [ensures]  @forAll Strictness.arbitrary { s | s == decodeS (show s) }@
 -}
decodeS :: String -> Strictness
decodeS s = fst (decode s) where
    decode     (s @ ´^u´)  = (U, strtail s 1)
    decode     (s @ ´^s´)  = (S list, rest) where (list,rest) = decodeList (strtail s 1)
    decode     s           = Prelude.error ("decodeS: bad string " ++ s.show)
    decodeList (s @ ´^\(´) = listElems (strtail s 1)
    decodeList  s          = ([], s)
    listElems  (s @ ´^\)´) = ([], strtail s 1)
    listElems   s          = (e:elems,rest) where
                                                (e,rs)       = decode s
                                                (elems,rest) = listElems rs


